home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / source / MacQForth Source / ProDOS.mops < prev    next >
Text File  |  1995-03-29  |  7KB  |  69 lines
  1. \ Section: ProDOS Traps
  2.    
  3. \ *
  4. \ *
  5. \ *  Link external monitor and ProDOS routines to simulator
  6. \ *  via unused opcodes placed in memory at the locations   
  7. \ *  indicated.                                             
  8. \ *                                                         
  9. \ *
  10.  
  11.  
  12. \ ProDOS MLI command - all disk access accomplished through here ($FF)
  13. \
  14. \ This section uses Mops specific file access of necessity.
  15. \ Modify appropriately for other systems.
  16. \
  17.  
  18.   \ QForth allows up to three open files
  19.   
  20.   File f0   \ Mops file objects
  21.   File f1
  22.   File f2
  23.   File temp \ used by fcreate to preserve already open files
  24.   
  25.   String fname  \ general purpose file name (new: in initialize)
  26.  
  27.   variable func    \ ProDOS MLI command code
  28.   variable params  \ address of parameter table
  29.  
  30.   \ Support words
  31.   
  32.   \ N.B. ProDOS names are <length><text> format
  33.   : getName ( addr -- )  \ put the filename in fname
  34.      release: fname  new: fname \ clear it
  35.      dup c@ swap 1+ swap put: fname 
  36.   ;
  37.   
  38.   variable pushT
  39.   : pushQF ( n -- )  \ push n on the QForth stack
  40.      pushT ! F4 $@ 1+ F4 $! \ increment stack depth
  41.      pushT 3+ c@ EE $@ 1- AA00 + $! \ store lo byte
  42.      pushT 2+ c@ EE $@  AA00 + $!    \ store hi byte
  43.      EE $@ 2- EE $!                   \ adjust pointer
  44.   ;
  45.   
  46.   : popQF  ( -- n )   \ pop n off QForth stack
  47.      F4 $@ 1- F4 $!    \ decrement stack depth
  48.      EE $@ 1+ AA00 + $@ \ lo byte
  49.      EE $@ 2+ AA00 + $@  \ hi byte
  50.      100 * +              \ data value
  51.      EE $@ 2+ EE $!        \ bump pointer
  52.      dup 7FFF > if  10000 swap - negate  then  \ correct sign
  53.   ;
  54.     
  55.   : err ( ec -- )  \ error code to accumulator
  56.      abs dup 27 = if drop 4C then rA ! ;  \ flag -39 [EOF] as ProDOS EOF
  57.  
  58.   : paramAddr  \ return real world address of beginning of params table
  59.      params @ $0000 + ;
  60.   
  61.   : paramName  \ return the real world address of the filename
  62.      params @ 1+ $@  params @ 2+ $@ 100 * + $0000 + ;
  63.  
  64.   : getFileName  \ put the ProDOS file name in fname
  65.      paramName getName ;
  66.   
  67.   \ Individual ProDOS commands
  68.